home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 008 / edgra3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-02-22  |  21.0 KB  |  586 lines
  1. (*---
  2.   FileName : EDGRA3.pas                       Version : July 24, 1986
  3.                                               made by : JOS
  4.   Objective:
  5.       This is the EXTENDED graphics editor. version 3
  6. Last Changes
  7. Aug 21, 1986 => expansion of the help feature.
  8. Sep 26, 1986 => Addition of the CircleSegment routine. NOTE Active Color = 'E'
  9. ---*)
  10. program GRAPHICS_EDITOR;
  11. {$V-}    {V = avoid String Checking in passing parameters}
  12. {$I \JOS\JOS-var.pas}
  13.  
  14.                (* Variables Used for ED-GRA *)
  15. type
  16.    STRING10 = STRING[10];
  17. var
  18.    POSI, TOPP1, TNUMBP1, ITM,
  19.    X, Y, INCX, INCY, I, J,
  20.    ACTIVE_COLOR, COLOR         : integer;
  21.    HIRES_MODE, SAVE_FILE       : boolean;
  22.    FNAME                       : STRING8;
  23.    RESP, CH_MOVE               : char;
  24.  
  25.    { procedure to re-assign values to the variable  NUMB }
  26. procedure ASSIGN_VALUES (SYS_NUM, SHEET_NUM, CODE : integer); begin  end;
  27. {$I \jos\graph.p}
  28. {$I \JOS\JOS-UTIL.PAS}
  29. {$I \JOS\JOS-UTI2.pas}
  30. {$I \JOS\JOS-UTI3.pas}
  31. {$I \JOS\JOS-GRA2.PAS}
  32.  
  33. (*---   NOT VERY EFFICIENT ROUTINE IS NOT USED IN THIS FILE !!!!!!!
  34.    Procedure to fill a square (defined by x1,y1,x2,y2) of the screen
  35.       with a character number NCHAR.
  36.       if MODE = 0 is TextMode and CODE = 0 -> fill character byte.
  37.                                   CODE = 1 -> fill atribute byte.
  38.       MODE = 1 is HiRes, coordinates in Hires: 0 <= X <= 639, 0 <= Y <= 199.
  39.       MODE = 2 is HiRes, coordinates in TextMode: 0 <= X <= 80, 0 <= Y <= 25.
  40. ---*)
  41.  
  42. procedure CLR_AREA (X1, Y1, X2, Y2, NCHAR, MODE, CODE : INTEGER);
  43. VAR
  44.    X, Y  : INTEGER;
  45. begin
  46.    CASE MODE OF
  47.     0 : for Y := Y1 TO Y2 do
  48.             for X := X1 TO X2 do
  49.                MEM [$B800:$0 + (Y-1)*160 + (X-1)*2 + CODE] := NCHAR;
  50.     1 : for Y := Y1 TO Y2 do
  51.             if (Y MOD 2) = 0 then     
  52.                for X := (X1 DIV 8) TO (X2 DIV 8) do
  53.                   MEM [$B800:$0 + (Y DIV 2)*80 + X] := NCHAR
  54.             ELSE                      
  55.                for X := (X1 DIV 8) TO (X2 DIV 8) do
  56.                   MEM [$BA00:$0 + (Y DIV 2)*80 + X] := NCHAR;
  57.     2 : begin
  58.            Y1 := (Y1-1)*8;            Y2 := (Y2-1)*8 + 7;
  59.            for Y := Y1 TO Y2 do
  60.             if (Y MOD 2) = 0 then
  61.                for X := X1 TO X2 do  begin
  62.                   MEM [$B800:$0 + (Y DIV 2)*80 + X-1] := NCHAR;
  63.                   MEM [$BA00:$0 + (Y DIV 2)*80 + X-1] := NCHAR;
  64.                end;
  65.         end;
  66.    end;
  67. end;
  68.  
  69. procedure CODE_WRITE;
  70. begin
  71.    rewrite (CODEFILE);
  72.    for I := 1 to TOP do
  73.       case COMM[I] of
  74.        '*', ' ','@','#', 'T' :  writeln (CODEFILE, COMM[I], STNG[I]);
  75.        'N'  : begin
  76.                   write (CODEFILE, COMM[I]);
  77.                   for J := 1 to NPAR do write (CODEFILE, PAR[I,J]:4);
  78.                   J := PAR [I,3];
  79.                   writeln (CODEFILE, FORMAT[J,1]:4, FORMAT[J,2]:4,' ',
  80.                        NUMB [J]:FORMAT[J,1]:FORMAT[J,2],' ', STNG[i]);
  81.               end;
  82.       else begin
  83.               write (CODEFILE, COMM[I]);
  84.               for J := 1 to NPAR do write (CODEFILE, PAR[I,J]:4);
  85.               writeln (CODEFILE, ' ', STNG[i]);     end;
  86.       end; { case }
  87.    writeln (CODEFILE, 'Q    end of file set by EDGRA3');
  88.    writeln (TOP:10, 'Lineas written');
  89.    close (CODEFILE);
  90. end;
  91.  
  92. procedure CODE_LIST;
  93. var CH, CH2 : char;   LFR, LTO, LE, i, j : integer;
  94.    procedure LIST;
  95.    begin
  96.       ClrScr; gotoxy (20,2); write('This graph has ',TOP:3,' lineas');
  97.       gotoxy (10,5); write ('Give starting line :');
  98.       gotoxy (10,6); write ('Give ending line   :');
  99.       LFR := trunc(INPUT_REAL(34,5,LFR,  1, TOP-1, 5,0, CH));
  100.       LTO := trunc(INPUT_REAL(34,6,LTO,  LFR+1, TOP, 5,0, CH)); gotoxy(1,8);
  101.       for I := LFR to LTO do begin
  102.          write (i:3, ' => ');
  103.          case COMM[I] of
  104.           '*', ' ','@','#','Q', 'T' :  writeln (COMM[I], STNG[I]);
  105.           'N'  : begin
  106.                      write (COMM[I]);
  107.                      for J := 1 to NPAR do write (PAR[I,J]:4);
  108.                      J := PAR [I,3];
  109.                      writeln (FORMAT[J,1]:4, FORMAT[J,2]:4,' ',
  110.                           NUMB [J]:FORMAT[J,1]:FORMAT[J,2],' ', STNG[i]);
  111.                  end;
  112.          else begin
  113.                  write (COMM[I]);
  114.                  for J := 1 to NPAR do write (PAR[I,J]:4);
  115.                  writeln (' ', STNG[i]);     end;
  116.          end; { case }
  117.       end;
  118.       writeln; writeln; writeln;
  119.    end;
  120.  
  121.    procedure EDIT_L;
  122.    begin
  123.       CLR_LINES(23,25);
  124.       gotoxy (1,23); write ('EDIT #',LE:4,' => ', COMM [LE]:1,' ');
  125.       for i := 1 to NPAR do write(PAR [LE,i]:6); I := 1;
  126.       repeat
  127.          PAR [LE,i] := trunc(INPUT_REAL(13+6*i,23,PAR[LE,i],0,640,4,0,CH));
  128.          i := CURSOR_MOVE (i, 1, NPAR, CH);
  129.       until ch in [^M, ^[, ^R,^C ];
  130.    end;
  131.  
  132. begin
  133.    ClrScr; gotoxy (20,2); write('This graph has ',TOP:3,' lineas');
  134.    LE := 1; CH := ^E;   LFR := 1; LTO := TOP;
  135.    if TOP > 0 then begin
  136.       repeat
  137.          if CH in [^A,^E,^R, ^Z,^X,^C] then LIST;
  138.          gotoxy (1,24); write ('<Esc> = exit. Enter line # to edit :');
  139.          LE := trunc(INPUT_REAL (38,24,LE, 1, TOP, 3, 0, CH));
  140.          if CH in [^M,^A,^E,^R, ^Z,^X,^C] then EDIT_L;
  141.       until CH = ^[;
  142.    end;
  143. end;
  144.  
  145. function  STAT(K : integer) : string80;
  146. var
  147.    NUM : array [1..npar] of string10;
  148.    J   : integer;
  149. begin
  150.    if (0 < K) and (K <= TOP) then
  151.       if COMM [K] in ['A','B','C','D','W','N'] then begin
  152.          STR (PAR[K,1], NUM[1]);
  153.          for j := 2 to NPAR do begin
  154.             STR (PAR[K,J]:2, NUM[J]);  NUM[J] := CONCAT (',',NUM[J]);
  155.          end;
  156.          CASE COMM[K] OF
  157.          'A':STAT:=CONCAT ('ARROW (',NUM[1],NUM[2],NUM[3],NUM[4],');');
  158.          'B':STAT:=CONCAT ('BOX   (',NUM[1],NUM[2],NUM[3],NUM[4],');');
  159.          'C':STAT:=CONCAT ('CIRCLE(',NUM[1],NUM[2],NUM[3],');');
  160.          'D':STAT:=CONCAT ('DRAW  (',NUM[1],NUM[2],NUM[3],NUM[4],');');
  161.          'W':STAT:=CONCAT ('WRS   (',NUM[1],NUM[2],',''', STNG [K],''');');
  162.         end;
  163.       end;
  164. end;
  165.                                        (*----  Make draws begin  ----*)
  166. procedure CURSOR (COLOR : integer);
  167. begin
  168.    DRAW (X-5,Y-5,  X+5, Y+5, COLOR);    DRAW (X-5,Y+5, X+5,Y-5, COLOR);
  169.    (*   DRAW (X-5, Y,   X+5, Y, COLOR);    DRAW (X,   Y-5, X  , Y+5, COLOR);*)
  170. end;
  171.  
  172. procedure MOVE_CURSOR;
  173. begin
  174.    repeat
  175.       CH_MOVE := GET_CHAR;
  176.       case CH_MOVE of
  177.        'X' : INCX := INCX + 1;     'x' : INCX := INCX - 1;
  178.        'Y' : INCY := INCY + 1;     'y' : INCY := INCY - 1;
  179.       end;
  180.       if Upcase (CH_MOVE) in ['X','Y'] then begin
  181.          gotoxy(16, YTEXT1); write(INCX:2);  gotoxy(22,YTEXT1); write(INCY:2);
  182.       end;
  183.    until CH_MOVE IN [^A,^E,^R, ^S,^D,  ^Z,^X,^C, ' '];
  184.    CURSOR (0);
  185.    CASE CH_MOVE OF
  186.      ^A, ^E, ^R : Y := Y - INCY;  {UP }
  187.      ^Z, ^X, ^C : Y := Y + INCY;  {DOWN }
  188.      ^S : X := X - INCX;  {LEFT }
  189.      ^D : X := X + INCX;  {RIGHT }
  190.    end;
  191.    CASE CH_MOVE OF
  192.      ^A, ^Z : X := X - INCX;  {LEFT }
  193.      ^R, ^C : X := X + INCX;  {RIGHT }
  194.    end;
  195.    IF X < 0 THEN X := 0;   IF X > 639 THEN X := 639;
  196.    IF Y < 0 THEN Y := 0;   IF Y > 199 THEN Y := 199;
  197.    IF CH_MOVE <> ' ' THEN CURSOR (1);
  198.    gotoxy (3,YTEXT1);write(X:3);  gotoxy(9,YTEXT1);  write(Y:3);
  199. end;
  200.  
  201. procedure COLOR_BOXES;
  202. begin
  203.  if not HIRES_MODE then begin
  204.    BOX (280, YTEXT2*8-8,288,YTEXT2*8-1, 1); fillShape (284, YTEXT2*8-4,0,1);
  205.    BOX (290, YTEXT2*8-8,298,YTEXT2*8-1, 1); fillShape (294, YTEXT2*8-4,1,1);
  206.    BOX (300, YTEXT2*8-8,308,YTEXT2*8-1, 1); fillShape (304, YTEXT2*8-4,2,1);
  207.    BOX (310, YTEXT2*8-8,318,YTEXT2*8-1, 1); fillShape (314, YTEXT2*8-4,3,1);
  208.  end;
  209. end;
  210.  
  211. procedure ASK_POSITION;
  212. var
  213.    CH3 : CHAR;     ST : STRING80;  TMP : REAL;
  214. begin
  215.    repeat
  216.       if HIRES_MODE then
  217.        CH3:=SCRIO_CHAR(1,YTEXT1,'<RETURN>=add line, <R>=replace, <Esc>=cancel')
  218.       else
  219.        CH3:=SCRIO_CHAR(1,YTEXT1,'<RET>=add, <R>eplace, <Esc>=Exit');
  220.    until CH3 in ['R', 'I', ^M, ^[ ];
  221.    case CH3  of
  222.     'R' : begin
  223.             gotoxy(1,YTEXT1); write (' ':39);
  224.             TMP := SCRIO_REAL (1,YTEXT1,'Replace line #', 0, TOP, 3,0);
  225.             POSI := TRUNC(TMP);
  226.             if POSI > 0 then begin
  227.                ST := STAT (POSI);  gotoxy (1,YTEXT1);
  228.                write ('Replacing..<RETURN>=con.,<Esc>=Cancel');
  229.                gotoxy (1,YTEXT3); write (ST);
  230.                CH3 := INPUT_CHAR;
  231.                if CH3 = ^M then begin
  232.                   EXEC (POSI, false);
  233.                   COMM[POSI] := COMM [TOPP1];  STNG [POSI] := STNG [TOPP1];
  234.                   FOR I := 1 TO NPAR DO PAR[POSI,I] := PAR [TOPP1,I];
  235.                end;
  236.                gotoxy (1,YTEXT3); write (' ':50);
  237.             end;
  238.          end;
  239.     ^M  :  begin
  240.               TOP := TOP + 1;   { Return }
  241.               if COMM [TOP] = 'N' then TOP_NUMB := TOP_NUMB + 1;
  242.            end;
  243.     ^[  :  EXEC (TOPP1, false);  { Esc }
  244.    end {case}
  245. end;
  246.  
  247. procedure  MAKE (CODE : char; ST_CODE : string10);
  248. var
  249.    LEN1, CP, TAKEN, F1, F2, F3   : integer;    EC : char;
  250.  
  251.    procedure SECOND_POINT;
  252.    begin
  253.       repeat
  254.          MOVE_CURSOR;
  255.          EXEC (TOPP1, false);
  256.          case CODE of
  257.           'C', 'S' :   PAR[TOPP1,3] :=
  258.                   round( SQRT( SQR( PAR[TOPP1,1]-X ) + SQR( PAR[TOPP1,2]-Y ) ));
  259.           'A','B','D','G' : begin
  260.                   PAR [TOPP1,3] := X;     PAR [TOPP1,4] := Y;    end;
  261.           'N'  : begin
  262.                   PAR [TOPP1,1] := (X div 8)+1;   PAR [TOPP1,2] := (Y div 8)+1;
  263.                   gotoxy (LEN1,YTEXT2);
  264.                   write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ','); end;
  265.           'W' : begin
  266.                  PAR [TOPP1,1] := X;  PAR [TOPP1,2] := Y;
  267.                   gotoxy (LEN1,YTEXT2);
  268.                   write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ','); end;
  269.          end;
  270.          EXEC (TOPP1,true);
  271.       until CH_MOVE = ' ';
  272.    end;
  273.  
  274. begin
  275.    TOPP1 := TOP + 1;
  276.    for i := 1 to NPAR do PAR [TOPP1,I] := 0;
  277.    STNG [TOPP1] := '';
  278.    COMM [TOPP1] := CODE;
  279.    PAR [TOPP1,5] := ACTIVE_COLOR;
  280.    LEN1 := LENGTH (ST_CODE) + 1;
  281.    case CODE of
  282.     'W' : begin  gotoxy (1,YTEXT2);  write('String ? ');  read (STNG [TOPP1]);
  283.             write(' Direction ?'); readln (PAR [TOPP1,3]);
  284.             INCX := 8;   INCY := 8;  end;
  285.     'G' : begin  gotoxy (1,YTEXT2);  write('Function # ? ');read (STNG [TOPP1]);
  286.           end;
  287.     'S' : begin { Circle Segment }
  288.             gotoxy (1,YTEXT2); write ('Ang Begin & End :'); 
  289.             readln (PAR [TOPP1,4],PAR [TOPP1,5]);
  290.           end;
  291.     'N' : begin
  292.             TNUMBP1 := TOP_NUMB + 1;   gotoxy (1,YTEXT2); write (' ':40);
  293.             gotoxy (1,YTEXT3);  write('# Pos = --    # Dec = --');
  294.             gotoxy (1,YTEXT2);  write(' Indx = --    Value =       ');
  295.             CP := 1;  TAKEN := 0; F1 := 2; F2 := 0; F3 := 0; NUMB[TNUMBP1] := 0;
  296.             repeat
  297.                case CP of
  298.                1 : F1 := trunc(INPUT_REAL  (8,YTEXT3,F1,  1,40, 3,0,EC));
  299.                2 : F2 := trunc(INPUT_REAL (22,YTEXT3,F2,  0, 9, 3,0,EC));
  300.                3 : F3 := trunc(INPUT_REAL (8,YTEXT2, F3,-99,99, 3,0,EC));
  301.                4 : numb [TNUMBP1] := INPUT_REAL (22,YTEXT2, NUMB[TNUMBP1],
  302.                      -9.9E9, 9.9E9,F1, F2, EC);
  303.                end;
  304.                TAKEN := TAKEN or (1 shl (CP-1));
  305.                CP := CURSOR_MOVE (CP, 1, 4, EC);
  306.             until (EC = ^M) and (TAKEN = $0F);
  307.             CLR_LINES (YTEXT2,YTEXT3);   FORMAT [TNUMBP1,1]:=F1;
  308.             FORMAT [TNUMBP1,2]:=F2;      PAR [TOPP1,4] := F3;
  309.             PAR [TOPP1,3] := TNUMBP1;    NUM_IDX [TNUMBP1] := TOPP1;
  310.             X := (X div 8) * 8; Y := (Y div 8) * 8;
  311.             INCX := 8;  INCY := 8;  end;
  312.     'F' : begin
  313.             COLOR_BOXES;
  314.             gotoxy (1,YTEXT2);  write ('FillColor :','Border :':12);
  315.             PAR [TOPP1,5]:=trunc(INPUT_REAL(12,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC));
  316.             PAR [TOPP1,4] := trunc (INPUT_REAL (25,YTEXT2,0,0,3,2,0,ec));
  317.           end;
  318.    end;
  319.    CLR_LINES(YTEXT2,YTEXT2);   gotoxy (1,YTEXT2);   write(ST_CODE);
  320.    CURSOR (1);
  321.    repeat
  322.       MOVE_CURSOR;
  323.    until CH_MOVE = ' ';
  324.    PAR [TOPP1,1] := X;     PAR [TOPP1,2] := Y;
  325.    case CODE of
  326.     'N'      : begin                   { from HIRES to TEXTMODE }
  327.             PAR [TOPP1,1] := (X div 8)+1;   PAR [TOPP1,2] := (Y div 8)+1; end;
  328.     'A','B','D','G' : begin
  329.             PAR [TOPP1,3] := X;     PAR [TOPP1,4] := Y;    end;
  330.    end;
  331.    gotoxy (LEN1,YTEXT2); write ( PAR[TOPP1,1]:3, ',', PAR[TOPP1,2]:3, ',');
  332.    CURSOR (1);
  333.    if CODE in ['W','N'] then EXEC (TOPP1, true);
  334.    if CODE = 'F' then begin
  335.        CURSOR (0);  exec_all (false);
  336.        EXEC (TOPP1, true) ; end
  337.    else
  338.       SECOND_POINT;
  339.    gotoxy (LEN1 + 8,YTEXT2);  write (PAR[TOPP1,3]:3, ',',PAR[TOPP1,4]:3, ')');
  340.    ASK_POSITION;
  341. end;
  342.  
  343.  
  344. procedure  CHNG_INPUT_AREA;
  345. begin
  346.    if YTEXT1 = 1 then begin   CLR_AREA (1,1, 80,3, $0, 2,0);
  347.       YTEXT1 := 25;     YTEXT2 := 24;     YTEXT3 := 23;     YGRAPH := 180; end
  348.    else begin  CLR_AREA (1,23, 80,25, $0, 2,0);
  349.       YTEXT1 := 1;      YTEXT2 := 2;      YTEXT3 := 3;      YGRAPH := 20; end;
  350.    EXEC_ALL (false);
  351. end;
  352.  
  353. procedure PROMPED (S : STRING15);
  354. begin
  355.    CLR_LINES (YTEXT1, YTEXT2);
  356.    draw (0,YGRAPH, 639,YGRAPH,1);   gotoxy (1,YTEXT1);
  357.    write ('X=',X:3,' Y=',Y:3,' Ix=',INCX:2,' IY=',INCY:2,' # S=',TOP:3);
  358.    gotoxy (1,YTEXT2); write ( S );
  359. end;
  360.  
  361. procedure HELP;
  362. var BUFFER : array [1..16287] of byte;
  363.  
  364.    procedure HELP_CTRL (PAGE : integer);
  365.    var  CH : char;   code : integer;
  366.    begin
  367.       repeat
  368.          clrscr;  gotoxy (1,1); write ('Page:', (PAGE-1):3);
  369.          display_page (PAGE,0,0);
  370.          gotoxy (1,24); write ('<Esc> = Exit, (1-5) = Help page #');
  371.          CH := GET_CHAR;
  372.          if CH in ['1'..'5'] then
  373.             begin Val (CH,page,code); page := page + 1;  end;
  374.       until CH in [^[, ^M];
  375.    end;
  376.  
  377. begin
  378.    if SCR_MODE < 4  then
  379.       HELP_CTRL (2)
  380.    else begin
  381.       if HIRES_MODE then
  382.          GetPic (BUFFER, 0,0,639, 199) else GetPic (BUFFER, 0,0,319, 199);
  383.       TextMode;    HELP_CTRL (2);
  384.       if HIRES_MODE then  HiRes  else GraphColorMode;
  385.       PutPic (BUFFER, 0,199);
  386.    end;
  387. end;
  388.  
  389. {   ========================== }
  390.  
  391. procedure SETP (CODE : char; ST_CODE : string10);
  392. var    EC : char;
  393. begin
  394.    gotoxy (1,YTEXT2); write (ST_CODE);
  395.    case CODE of
  396.     'C' : begin
  397.             COLOR_BOXES;
  398.             ACTIVE_COLOR:=trunc(INPUT_REAL(16,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC));
  399.           end;
  400.     'P' : begin
  401.             TOPP1 := TOP + 1;
  402.             for i := 1 to NPAR do PAR [TOPP1,i] := 0;   STNG [TOPP1] := '';
  403.             COMM [TOPP1] := 'P';
  404.             PAR [TOPP1,1]:=trunc(INPUT_REAL(12,YTEXT2,ACTIVE_COLOR,0,3,2,0,EC));
  405.             exec (TOPP1, true);
  406.             ASK_POSITION;
  407.           end;
  408.     '@','#','T' : begin
  409.             TOP := TOP + 1;
  410.             for i := 1 to NPAR do PAR [TOP,i] := 0;   COMM [TOP] := CODE;
  411.             read (STNG [TOP] );
  412.           end;
  413.    end;
  414. end;
  415.  
  416. procedure EDIT;
  417. var   SW_EXIT, SW_MODE, SW_CARD  : boolean;    PROM_STR : STRING15;
  418. begin
  419.    clrscr;
  420.    if SCRIO_CHAR (30, 12, 'Hires or Graphics mode ? (H/G)') = 'H' then begin
  421.       HIRES_MODE := true; hires;     hirescolor (1);    X := 320;    end
  422.    else begin
  423.       HIRES_MODE := false; graphColorMode;      X := 160;
  424.    end;
  425.    SW_MODE := false;  PROM_STR := 'COMMAND ?';
  426.    if SW_CARD  then begin
  427.       fillchar ( mem[$BC00:0], 16384, 0 );         { see NOTE 1 }
  428.       port [$3D9] := 32;    PORT [$3DD] := 32;
  429.    end;
  430.    Y := 100;  INCX := 8;  INCY := 5;    SW_EXIT := false;
  431.    YTEXT1 := 25;     YTEXT2 := 24;   YTEXT3 := 23; YGRAPH := 180;
  432.    ACTIVE_COLOR := 1;
  433.    EXEC_ALL (FALSE);
  434.    repeat
  435.        PROMPED ( PROM_STR );
  436.        RESP := Upcase (INPUT_CHAR);
  437.        if SW_MODE and (RESP in ['A'..'Z']) then SAVE_FILE := true;
  438.        if SW_MODE then
  439.          CASE RESP OF
  440.           'A' : MAKE ('A', 'ARROW (');
  441.           'B' : MAKE ('B', 'BOX (');
  442.           'C' : MAKE ('C', 'CIRCLE (');
  443.           'S' : MAKE ('S', 'CircSeg (');
  444.           'D' : MAKE ('D', 'DRAW (');
  445.           'G' : MAKE ('G', 'GRAPH (');
  446.           'N' : MAKE ('N', 'NUMBER (');
  447.           'W' : MAKE ('W', 'write (');
  448.           'F' : MAKE ('F', 'Fill (');
  449. {????}    'E' : SETP ('C', 'Active-color :');
  450.           'P' : SETP ('P', 'Pallete :');
  451.           '@' : SETP ('@', '@ Segment Comment :');
  452.           '#' : SETP ('#', '# End Seg.Comment :');
  453.           'T' : SETP ('T', 'T title   Comment :');
  454.           '?' : HELP;
  455.           ^[  : begin PROM_STR := 'COMMAND ?';  SW_MODE := false; end;
  456.          else  write (^G);
  457.          end
  458.        else
  459.          CASE UPCASE(RESP) OF
  460.           'P' : begin CLR_AREA (0,0, 639,199,$0,1,0); EXEC_ALL (TRUE);
  461.                   readln(KBD);  end;
  462.           'R' : EXEC_ALL (FALSE);
  463.           'S' : begin   CODE_WRITE;    SAVE_FILE := false;  end;
  464.           'I' : CHNG_INPUT_AREA;
  465.           '?' : HELP;
  466.           'K' : begin graphWindow (20,20,50,50);
  467.                 READLN (I);  HIRESCOLOR (I);  end;
  468.           'D' : begin PROM_STR := 'DRAWING ?';  SW_MODE := true; end;
  469.           ^[  : SW_EXIT := true;
  470.          else  write (^G);
  471.        end;
  472.    until SW_EXIT;
  473.    textmode;
  474. end;
  475.  
  476. function CHECK_SAVE : boolean;
  477. begin
  478.    gotoxy (5,25); write (^g, ^g, 'The file in memory :',CODE_in_MEM,
  479.    'has not been saved, SAVE IT ? (Y/N)');
  480.    repeat
  481.       RESP := Upcase (INPUT_CHAR);
  482.    until RESP in ['Y','N'];
  483.    CHECK_SAVE := (RESP = 'Y');
  484. end;
  485.  
  486. procedure NO_DEF;
  487. begin
  488.    gotoxy (10,22);   writeln ('There in NO file name defined', ^G, ^G);
  489.    writeln ('Use the CREATE, LOAD or RENAME options to define a name');
  490.    readln;
  491. end;
  492.  
  493. procedure GET_FN;
  494. begin
  495.    write ('The existing file names are:':53);
  496.    LIST_GET_FILEN ('L', '????????.cod-', FNAME, RESP);
  497.    gotoxy (20,21);  write ('Give NEW File Name (w/o ext.) ?:');
  498.    read (FNAME);
  499.    if FNAME <> '' then begin
  500.       CFNAME := FNAME + '.cod';
  501.       CODE_in_MEM := CFNAME;
  502.       assign (CODEFILE, CFNAME);
  503.    end;
  504. end;
  505.  
  506. begin { MAIN }
  507. {   for i := 1 to NLIM do STNG [i] := ''; }
  508.    TOP := 0; SW_CARD := True;  SAVE_FILE := false;
  509.  
  510.    CODE_in_MEM := '-none-';
  511.    READ_SCREENS ('EDGRA.men');     ITM := 1;
  512.    repeat
  513.       DISPLAY_PAGE (1, 0, 1);
  514.       gotoxy (28,3); write (DefaultDrive);
  515.       gotoxy (28,4); write (CODE_in_MEM);
  516.       ITM := CHOOSE_LINES (1, ITM, 10, 0);
  517.       case ITM of
  518.         1 : HELP;
  519. {ed}    2 : if CODE_in_MEM = '-none-' then NO_DEF else EDIT;
  520. {Run}   3 : if CODE_in_MEM = '-none-' then NO_DEF else begin
  521.                SW_COLOR := true;    SW_CARD := true;
  522.                HIRES_MODE := true;  INCX := 2;
  523.                RUN_GRAFI (CFNAME, INCX, resp, 0, 0);
  524.             end;
  525. {List}  4 : if CODE_in_MEM = '-none-' then NO_DEF else CODE_LIST;
  526. {Crea}  5 : begin
  527.                if SAVE_FILE then if CHECK_SAVE then CODE_WRITE;
  528.                ClrScr; writeln ('C R E A T E':45);
  529.                GET_FN;
  530.                if FNAME <> '' then begin
  531.                   TOP := 0;  TOP_SEGMENT := 0;  TOP_NUMB := 0; end
  532.             end;
  533. {Load}  6 : begin
  534.                if SAVE_FILE then if CHECK_SAVE then CODE_WRITE;
  535.                ClrScr;
  536.                LIST_GET_FILEN ('G', '????????.cod-', FNAME, RESP);
  537.                if RESP <> ^[ then begin
  538.                   CFNAME := FNAME + '.cod';
  539.                   CODE_in_MEM := CFNAME;
  540.                   assign (CODEFILE, CFNAME);
  541.                   CODE_READ;
  542.                end;
  543.             end;
  544. {Save}  7 : if CODE_in_MEM = '-none-' then NO_DEF else begin
  545.                CODE_WRITE;
  546.                SAVE_FILE := false;
  547.             end;
  548.  
  549.         8 : begin ClrScr; writeln ('R E N A M E':45);
  550.                GET_FN;
  551.            end;
  552.         9 : SET_DRIVE ( SCRIO_CHAR (10, 21,'Enter new drive') );
  553.        10 : begin ClrScr; LIST_GET_FILEN ('L', '????????.cod-', FNAME, RESP);
  554.            end;
  555.       end;
  556.    until ITM = 0;
  557.    if SAVE_FILE then if CHECK_SAVE then CODE_WRITE;  CLRSCR;
  558. end.
  559.  
  560.  
  561.         '@'     : begin                           { Define Segment }
  562.                      if TOP_SEGMENT >= TOPSEG_LIM then  ERROR (3)
  563.                      else begin
  564.                         TOP_SEGMENT := TOP_SEGMENT + 1;
  565.                         COLOR_SEG [TOP_SEGMENT,1] := TOP + 1;  { begin_line }
  566.                         COLOR_SEG [TOP_SEGMENT,2] := 0;        { end_line }
  567.                         if TOP_SEGMENT > 1 then
  568.                            COLOR_SEG [TOP_SEGMENT-1,2] := TOP - 1; { end_line }
  569.                         read (CODEFILE, STNG[TOP]);
  570.                      end;
  571.                   end;
  572.         '#'     : if TOP_SEGMENT > 0 then
  573.                            COLOR_SEG [TOP_SEGMENT,2] := TOP - 1; { end_line }
  574.  
  575.         'T'     : begin TITLE_SEG [1] := TOP + 1;                { Tiles !! }
  576.                         read (CODEFILE, STNG[TOP]);  end;
  577.  
  578.         'Q'     : begin                                          { End Ploting }
  579.                   TOP := TOP - 1;  { Do NOT keep Q }
  580.                   if (TOP_SEGMENT > 0) and (COLOR_SEG [TOP_SEGMENT,2] = 0) then
  581.                            COLOR_SEG [TOP_SEGMENT,2] := TOP; { end_line }
  582.                   TITLE_SEG [2] := TOP;
  583.                   end;
  584.  
  585. 
  586.